# steps 4,5, 6 use euclidean distance
library(plotly)

Question 1.

# keep columns 1,2,5,6,7,9,10,16,17,18,19
p_e <- prices_earnings[, c(1,2,5,6,7,9,10,16,17,18,19)]
rownames(p_e) <- p_e[[1]]

Question 2.

Without doing any reordering We cannot identify any clusters or outliers.

#p_e_sc %>% 
  plot_ly(x =~colnames(p_e_sc), y =~rownames(p_e_sc),
    z = ~p_e_sc, type = "heatmap", 
    colors = colorRamp(c("black","red"))
  ) %>%
  layout(title =  "Heatmap of prices and earnings",
         xaxis = list(title = "Price-Earnings Indicators", zeroline = FALSE),
         yaxis = list(title = "Cities", zeroline = FALSE)
  )

Question 3.

# seriation needs to permute rows and columns, thus distance by row and column
p_e_rdist <- dist(p_e_sc, method = "euclidean")
p_e_cdist <- dist(t(p_e_sc), method = "euclidean")
# computing distance as one minus correlation
p_e_cor <- 1 - cor(p_e_sc)
# as distance
p_e_cor_dist <- as.dist(p_e_cor)
LS0tDQp0aXRsZTogIlZpc3VhbGl6YXRpb24gTGFiIDMiDQphdXRob3I6ICJSb3NobmkgU3VuZGFyYW11cnRoeSAocm9zc3U4MDkpICYgQnJpYW4gTWFzaW5kZSAoYnJpbWE3NDgpIg0KZGF0ZTogIjI2IFNlcHRlbWJlciAyMDE4Ig0Kb3V0cHV0Og0KICBodG1sX2RvY3VtZW50Og0KICAgIGRmX3ByaW50OiBwYWdlZA0KICBodG1sX25vdGVib29rOg0KICAgIHRoZW1lOiBqb3VybmFsDQogIHBkZl9kb2N1bWVudDogZGVmYXVsdA0KZm9udHNpemU6IDExcHQNCmJpYmxpb2dyYXBoeTogcmVmZXJlbmNlcy5iaWINCi0tLQ0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFLCBwYWdlZC5wcmludD1GQUxTRX0NCiMgc3RlcHMgNCw1LCA2IHVzZSBldWNsaWRlYW4gZGlzdGFuY2UNCmxpYnJhcnkocGxvdGx5KQ0KYGBgDQoNCmBgYHtyIGRhdGEsIGVjaG8gPSBGQUxTRX0NCnByaWNlc19lYXJuaW5ncyA8LSByZWFkLmRlbGltKCJwcmljZXMtYW5kLWVhcm5pbmdzLnR4dCIpDQpgYGANCiMjIyBRdWVzdGlvbiAxLg0KYGBge3J9DQojIGtlZXAgY29sdW1ucyAxLDIsNSw2LDcsOSwxMCwxNiwxNywxOCwxOQ0KDQpwX2UgPC0gcHJpY2VzX2Vhcm5pbmdzWywgYygxLDIsNSw2LDcsOSwxMCwxNiwxNywxOCwxOSldDQoNCnJvd25hbWVzKHBfZSkgPC0gcF9lW1sxXV0NCmBgYA0KDQpgYGB7ciBzY2FsZSwgZWNobyA9IEZBTFNFfQ0KIyBxdWVzdGlvbiAyIHNjYWxpbmcNCnBfZV9zYyA8LSBzY2FsZShwX2VbLC0xXSkNCg0KYGBgDQoNCiMjIyBRdWVzdGlvbiAyLg0KV2l0aG91dCBkb2luZyBhbnkgcmVvcmRlcmluZyBXZSBjYW5ub3QgaWRlbnRpZnkgYW55IGNsdXN0ZXJzIG9yIG91dGxpZXJzLg0KDQpgYGB7ciBoZWF0bWFwfQ0KI3BfZV9zYyAlPiUgDQogIHBsb3RfbHkoeCA9fmNvbG5hbWVzKHBfZV9zYyksIHkgPX5yb3duYW1lcyhwX2Vfc2MpLA0KICAgIHogPSB+cF9lX3NjLCB0eXBlID0gImhlYXRtYXAiLCANCiAgICBjb2xvcnMgPSBjb2xvclJhbXAoYygiYmxhY2siLCJyZWQiKSkNCiAgKSAlPiUNCiAgbGF5b3V0KHRpdGxlID0gICJIZWF0bWFwIG9mIHByaWNlcyBhbmQgZWFybmluZ3MiLA0KICAgICAgICAgeGF4aXMgPSBsaXN0KHRpdGxlID0gIlByaWNlLUVhcm5pbmdzIEluZGljYXRvcnMiLCB6ZXJvbGluZSA9IEZBTFNFKSwNCiAgICAgICAgIHlheGlzID0gbGlzdCh0aXRsZSA9ICJDaXRpZXMiLCB6ZXJvbGluZSA9IEZBTFNFKQ0KICApDQpgYGANCg0KIyMjIFF1ZXN0aW9uIDMuDQoNCmBgYHtyIFF1ZXN0aW9uM19hfQ0KIyBzZXJpYXRpb24gbmVlZHMgdG8gcGVybXV0ZSByb3dzIGFuZCBjb2x1bW5zLCB0aHVzIGRpc3RhbmNlIGJ5IHJvdyBhbmQgY29sdW1uDQpwX2VfcmRpc3QgPC0gZGlzdChwX2Vfc2MsIG1ldGhvZCA9ICJldWNsaWRlYW4iKQ0KDQpwX2VfY2Rpc3QgPC0gZGlzdCh0KHBfZV9zYyksIG1ldGhvZCA9ICJldWNsaWRlYW4iKQ0KYGBgDQoNCg0KDQpgYGB7ciBxdWVzdGlvbjNfYn0NCiMgY29tcHV0aW5nIGRpc3RhbmNlIGFzIG9uZSBtaW51cyBjb3JyZWxhdGlvbg0KDQpwX2VfY29yIDwtIDEgLSBjb3IocF9lX3NjKQ0KDQojIGFzIGRpc3RhbmNlDQpwX2VfY29yX2Rpc3QgPC0gYXMuZGlzdChwX2VfY29yKQ0KYGBgDQoNCmBgYHtyfQ0KDQpgYGANCg0K